'***********************************************************
'*                                                         *      
'*              W A V E F O R M   W O R K S H O P          *      
'*                                                         *      
'*                      By James Shields                   *      
'*                                                         *      
'*                                                         *      
'* Waveform Workshop allows the user to see and build      *
'* waveforms and save them as BASIC readable files, for    *
'* use in other programs.                                  *                   
'*                                                         *      
'***********************************************************

Main:

   GOSUB constants     'Set up the constants and arrays
   GOSUB mainscreen    'Set up the main screen
   GOSUB waveedit      'Edit waves
   CLOSE               'clean up
   WINDOW CLOSE 1
   WINDOW 1,,,,-1
   END

'* Begin Subroutine *'

constants:    'set up program constants and arrays

   OPTION BASE 0
   DIM wav%(256),pat%(1)
   DIM savewave%(256),demo!(13)
   
' calculate note data for sound demo
   
   FOR i=0 TO 12
      demo!(i+1) = INT(263*((2^(i/12))))
   NEXT i
   wavename$="Noname"           'Name the wave
   filename$="No file"          'Tell where it came from
   pat%(0)=255
   pat%(1)=255                  'Set up pattern fill data
   FOR i%=1 TO 128
      wav%(i%-1)=127              'Set up initial wave data
      wav%(256-i%)=-127
   NEXT i%
   WAVE 0,wav%
   WAVE 1,wav%
   WAVE 2,wav%
   true% = (1=1)                'Symbolic boolean constants are
   false% = (1=0)               'used throughout.
   notsaved% = false%
   firstwave%=true%             'First time through 
   
RETURN

'* Begin Subroutine *'

mainscreen:                     'main wave editing screen
                    
SCREEN 1,640,200,3,2
WINDOW 1,"Waveform Workshop",,0,1
WINDOW OUTPUT 1

PALETTE 1,0.6,0.6,0.6              'define colors used
PALETTE 0,0,0,0
PALETTE 2,1,0.9,0
PALETTE 3,0.1,1,0.3
PALETTE 1,1,1,1
PALETTE 5,1,0.1,0.1
PALETTE 6,0.8,0.13,0.83
PALETTE 7,0.27,0.47,1
 
black  = 0                   'Use symbolic names for colors
grey   = 1                   'rather than color numbers.
yellow = 2                   'Saves wear and tear on programmers'
green  = 3                   'brains.
white  = 4
red    = 5
purple = 6
blue   = 7

CLS                          'Set the colors in use.
GOSUB mousereset

RETURN

'* Begin Subroutine *'

mousereset:     'wait until the mouse button is released

WHILE MOUSE(0) <>0
WEND
RETURN

'* Begin Subroutine *'

waveedit:                   'Set up the screen to edit
CLS
terminate% = false%         'We don't want to stop.
GOSUB wavescreen            'Display the screen.
WHILE NOT terminate%
LOCATE 1,1
PRINT SPACE$(65);           'Print the wave name and origin.
LOCATE 1,3
COLOR purple,black
PRINT "Waveform:  ";wavename$;TAB(40);
PRINT "Filename:  ";filename$
COLOR blue,black
   waitformouse1:                         'get a command.
      IF MOUSE(0)=0 THEN waitformouse1    
   x=MOUSE(1)
   y=MOUSE(2)
   IF (x<532) OR (x>545) THEN          'if there's an error
       PALETTE 0,1,1,1                 'flash the screen
       FOR i=1 TO 50
       NEXT i
       PALETTE 0,0,0,0
       WHILE MOUSE(0) <> 0
          WEND
       GOTO waitformouse1
   END IF

'Process the function selected.   
       
   playwave%     = ((y>15) AND (y<23))  
   newwave%      = ((y>31) AND (y<39)) 
   editwave%     = ((y>47) AND (y<55)) 
   displaywave%  = ((y>63) AND (y<71)) 
   namewave%     = ((y>79) AND (y<87))
   savewave%     = ((y>95) AND (y<103))
   loadwave%     = ((y>111) AND (y<119))
   noise%        = ((y>127) AND (y<135))
   exitwave%     = ((y>1) AND (y<9))
   
   IF playwave%    THEN GOSUB playwave
   IF newwave%     THEN GOSUB newwave
   IF editwave%    THEN GOSUB editwave
   IF displaywave% THEN GOSUB displaywave
   IF namewave%    THEN GOSUB namewave
   IF savewave%    THEN GOSUB savewave
   IF loadwave%    THEN GOSUB loadwave
   IF noise%       THEN GOSUB noise
   IF exitwave%    THEN GOSUB exitwave
   
   GOSUB mousereset    
   
   WEND

firstwave%=false%
RETURN

'* Begin Subroutine *'

wavescreen:             'Print the main editing screen.

CLS
CALL box(533,1,544,8,grey)
LOCATE 1,70
COLOR blue,black
PRINT "Exit"
CALL box(9,9,523,138,yellow)
LINE (10,74)-(522,74),yellow
LOCATE 3,70
COLOR blue,black
PRINT "Play"
LOCATE 5,70
CALL box(533,16,544,22,grey)    
PRINT "New "
CALL box(533,32,544,38,grey) 
LOCATE 7,70
PRINT "Edit"
CALL box(533,48,544,54,grey)
LOCATE 9,70
PRINT "Display"
CALL box(533,64,544,70,grey)
LOCATE 11,70
PRINT "Name"
CALL box(533,80,544,86,grey)
LOCATE 13,70
PRINT "Save"
CALL box(533,96,544,102,grey)
LOCATE 15,70
CALL box(533,112,544,118,grey)
PRINT "Load"
CALL box(533,128,544,134,grey)
LOCATE 17,70
PRINT "Noise"

RETURN

'* Begin Subroutine *'

playwave:                   'Demonstrate the sound 
GOSUB chords
playvave%=false%
RETURN
   
'* Begin Subroutine *'

chords:         'Play a scale and chords to demonstrate
SOUND RESUME    'the waveform sound.

SOUND demo!(1)/2,3    'c
SOUND demo!(3)/2,3    'd
SOUND demo!(5)/2,3    'e
SOUND demo!(6)/2,3    'f
SOUND demo!(8)/2,3    'g
SOUND demo!(10)/2,3   'a
SOUND demo!(12)/2,3   'b
SOUND demo!(1),3    'c
SOUND demo!(3),3    'd
SOUND demo!(5),3    'e
SOUND demo!(6),3    'f
SOUND demo!(8),3    'g
SOUND demo!(10),3   'a
SOUND demo!(12),3   'b
SOUND demo!(1)*2,3  'c
SOUND demo!(3)*2,3  'd
SOUND demo!(5)*2,3  'e
SOUND demo!(6)*2,3  'f
SOUND demo!(8)*2,3  'g
SOUND demo!(10)*2,3 'a
SOUND demo!(12)*2,3 'b
SOUND demo!(13)*2,3 'c1
SOUND WAIT                     'Syncronize the first chord.
'C
SOUND demo!(1)*2,20,140,0  'c
SOUND demo!(8),20,140,1    'g
SOUND demo!(1),20,140,2    'c

SOUND RESUME
'F
SOUND demo!(10),20,140,0   'a
SOUND demo!(6),20,140,1    'f
SOUND demo!(1),20,140,2    'c
'G
SOUND demo!(3),20,140,0    'd
SOUND demo!(8),20,140,1    'g
SOUND demo!(12),20,140,2   'b
'C
SOUND demo!(1)*2,20,140,0  'c
SOUND demo!(8),20,140,1    'g
SOUND demo!(1),20,140,2    'c

RETURN

'* Begin Subroutine *'

newwave:                    'Clear the old wave out
IF notsaved THEN GOSUB saveerror
GOSUB cleargraph
FOR i%=1 TO 128
      wav%(i%-1)=127             
      wav%(256-i%)=-127
NEXT i%
wavename$="Noname"
filename$="No file"
notsaved = false%
newwave%=false%
RETURN

'* Begin Subroutine *'

editwave:                    'Actually edit the wave 
GOSUB clearbottom            'Clear the dialogue window
COLOR yellow,black
LOCATE 23,5
PRINT "Compile wave";
CALL box(8,176,20,182,grey)
LOCATE 22,5
PRINT "Exit edit"
CALL box(8,166,20,172,grey)
GOSUB mousereset
mouseloop:                   'Draw what is pointed to.
IF MOUSE(0)=0 THEN      'If user released mouse button
   lastx=0              'Keep from drawing a bogus segment
   lasty=0
   GOTO mouseloop
END IF   
x=MOUSE(1)
y=MOUSE(2)

'Check to see if a command was selected.

commandrange = ((x>7) AND (x<21))    
IF (commandrange AND (y>165) AND (y<173)) THEN exitedit
IF (commandrange AND (y>175) AND (y<183)) THEN compilewave

'Check to see if the mouse is out of bounds.

IF (x<10) OR (x>522) OR (y<10) OR (y>137) THEN mouseloop

'If all is well, draw the segment of the wave.

IF lastx =0 THEN 
   lastx=x
   lasty=y
END IF
   
'erase any segments in the same X plane as the new segment
IF lastx<=x THEN s=1 :ELSE s= (-1)

COLOR black,black
AREA(lastx,10)
AREA STEP(ABS(lastx-x)*s,0)
AREA STEP(0,127)
AREA STEP(-(ABS(lastx-x))*s,0)
AREAFILL
LINE(lastx,74)-(x,74),yellow
LINE(lastx,lasty)-(x,y),red     'Draw the new segment.
lastx = x
lasty = y
GOTO mouseloop

'Wave editor commands:

compilewave:
   GOSUB recalcarray
   notsaved%=true%
RETURN

exitedit:
   editwave%=false%
   GOSUB clearbottom
   COLOR blue,black

RETURN

'* Begin Subroutine *'

recalcarray:            'read the screen data

GOSUB clearbottom
COLOR red,black

LOCATE 23,3
lastpoint = 10
wavedirection = 1  'is the wave rising or falling?

FOR i=0 TO 255
   j = lastpoint
   pointsscanned = 0
      scan:
      p=POINT(i*2+11,j)   
      IF p=red THEN
         IF (j<lastpoint) THEN wavedirection=(-1)
         IF (j>lastpoint) THEN wavedirection=1
         ' and if its neither leave it alone.
         lastpoint = j
         wav%(i)=127-(2*(j-9))
         'bounds check
         IF wav%(i)>127 THEN wav%(i)=127
         IF wav%(i)<-128 THEN wav%(i)=-128
         LINE(i*2+11,j)-(i*2+11,j),blue
         GOTO nextpoint
      END IF
   j=j+(wavedirection)
   pointsscanned = pointsscanned+1
   IF (j<10) OR (j> 139) THEN
       wavedirection = wavedirection * (-1)   
       j = lastpoint
   END IF    
   IF pointsscanned<127 THEN GOTO scan    
     'in case there is a blank space
nextpoint:        
NEXT i

GOSUB redrawwave

'reset the waveforms for the demo

WAVE 0,wav%
WAVE 1,wav%
WAVE 2,wav%

'clean up and exit

notsaved% = true%
GOSUB clearbottom
COLOR blue,black
RETURN

'* Begin Subroutine *'

cleargraph:            'Clear the waveform graph 

PATTERN ,pat%
AREA (10,10)
AREA STEP(512,0)
AREA STEP (0,128)
AREA STEP (-512,0)
COLOR black,black
AREAFILL
CALL box(9,9,523,139,yellow)
LINE(10,74)-(522,74),yellow
COLOR blue,black

RETURN

'* Begin Subroutine *'

displaywave:               'Display multiple waveforms 
                           'at the bottom
                           'of the screen.
GOSUB clearbottom
LINE(1,158)-(639,158),yellow
FOR i=1 TO 256  STEP 2

'Write out the smaller waveforms 5 times (for speed's sake)

   LINE(i/2+1,159-wav%(i)/8)-(i/2+1,159-wav%(i)/8),red
   LINE(i/2+129,159-wav%(i)/8)-(i/2+129,159-wav%(i)/8),red
   LINE(i/2+257,159-wav%(i)/8)-(i/2+257,159-wav%(i)/8),red
   LINE(i/2+385,159-wav%(i)/8)-(i/2+385,159-wav%(i)/8),red
   LINE(i/2+513,159-wav%(i)/8)-(i/2+513,159-wav%(i)/8),red

NEXT i
COLOR blue,black   
displaywave% = false%

RETURN

'* Begin Subroutine *'

redrawwave:               'Draw the wave in wav%()

GOSUB cleargraph
lasty=wav%(0)
FOR i=1 TO 256
   LINE((i-1)*2+11,74-lasty/2)-(i*2+11,74-wav%(i-1)/2),red
   lasty=wav%(i-1)
NEXT i    

RETURN

'* Begin Subroutine *'

clearbottom:            'Clear the dialogue window.

COLOR black,black
AREA (1,142)
AREA STEP (630,0)
AREA STEP(0,44)
AREA STEP(-630,0)
AREAFILL

RETURN

'* Begin Subroutine *'

namewave:              'Give the waveform a name.
GOSUB clearbottom
COLOR blue,black
LOCATE 22,3
INPUT "New name of wave";wavename$
namewave%=false%
GOSUB clearbottom
COLOR blue,black
RETURN

'* Begin Subroutine *'

savewave:               'Save the wave.
CLOSE #1        'Just in case
GOSUB clearbottom
COLOR green,black
LOCATE 22,3
INPUT "Filename (10 characters or less, EXIT to quit)";filename$
IF filename$="EXIT" THEN exitsave
IF LEN(filename$)>10 THEN 
    filename$=LEFT$(filename$,10)+".Wave"
ELSE
    filename$=filename$+".Wave"
END IF
ON ERROR GOTO newfile

'An error should occur if the file is not there.  If it is,
'then we go on and try to save.  Actually, an error here 
'indicates that things are ok, and no error indicates things
'need to be checked out -- the wave already exists. 

OPEN filename$ FOR INPUT AS #1
GOSUB clearbottom
COLOR red,black
LOCATE 22,3
PRINT "File exists; erase it? ";
GOSUB getyn
IF (answer$="n") OR (answer$="N") THEN savewave

newfile:
CLOSE #1      'Just in case it was open

OPEN filename$ FOR OUTPUT AS #1        
FOR i=1 TO 256
   WRITE #1,wav%(i)
   LOCATE 23,3
   PRINT "Saving point ";i;
NEXT i
CLOSE #1

exitsave:   
savewave%=false%
notsaved%=false%
GOSUB clearbottom
COLOR blue,black

RETURN

'* Begin Subroutine *'

loadwave:       'Load in a previously saved waveform.

loadwave%=false%
GOSUB clearbottom
COLOR blue,black
LOCATE 22,3
INPUT "Filename ";filename$
IF RIGHT$(filename$,5) <> ".Wave" THEN 
       filename$=filename$+".Wave"
END IF       
CLOSE #1       'Just in case
ON ERROR GOTO baddata

'Here, an error is really an error.

OPEN filename$ FOR INPUT AS #1
FOR i=0 TO 255
   INPUT #1,wav%(i)
   LOCATE 23,3
   PRINT "Reading point ";i;
NEXT i
CLOSE #1
wavename$=LEFT$(filename$,LEN(filename$)-5)
GOTO endload

baddata:
GOSUB clearbottom
COLOR red,black
LOCATE 22,3
PRINT "Unable to load file ";filename$;".  ";
IF ERR=53 THEN  
   PRINT "File not found." 
ELSE
   PRINT "File error."   
END IF
PRINT "   Try again? ";
GOSUB getyn
IF answer$="y" OR answer$="Y" THEN GOTO loadwave

endload:
notsaved% = false%
GOSUB clearbottom
COLOR blue,black
GOSUB redrawwave

RETURN

'* Begin Subroutine *'

noise:       'Add noise to the waveform.


noise%=false%
checkloop:
GOSUB clearbottom
COLOR blue,black
LOCATE 22,3
INPUT "Percentage of noise";noiseamount
IF noiseamount>100 THEN GOTO checkloop
FOR i=1 TO 256
   savewave%(i)=wav%(i)   'Temporarily save the old wave.
   IF (RND*100)<noiseamount THEN wav%(i)=127-INT(RND*256)
NEXT i

GOSUB redrawwave   'Show the noisy wave.
WAVE 0,wav%
WAVE 1,wav%
WAVE 2,wav%

GOSUB chords       'See what it sounds like.
GOSUB clearbottom
COLOR blue,black

LOCATE 23,3
PRINT "Use this wave? ";
GOSUB getyn
   IF (answer$="Y") OR (answer$="y") THEN exitnoise1
   FOR i=1 TO 256
      wav%(i)=savewave%(i)     'Restore the old wave
   NEXT i
   GOSUB clearbottom
   GOSUB redrawwave
   COLOR blue,black
   LOCATE 23,3
   PRINT "Try again? ";
   GOSUB getyn
   IF (answer$="n") OR (answer$="N") THEN exitnoise
GOTO loop3 
   
exitnoise1:
notsaved% = true%

exitnoise:   
GOSUB clearbottom
COLOR blue,black

RETURN


'* Begin Subroutine *'

exitwave:    'Finish up.

LOCATE 1,1
PRINT SPACE$(80);
LOCATE 1,2
COLOR red,black
PRINT "Exit wave selected."
IF notsaved% THEN GOSUB saveerror
terminate%=true%
exitwave%=false%
RETURN


'* Begin Subroutine *'

initwaves:              'Zero the waveform arrays.

FOR i =0 TO 255
   wav%(i)=0
NEXT i

RETURN

'* Begin Subroutine *'

saveerror:                   'Check to be sure the user  
                             'wants to abandon the wave.
GOSUB clearbottom            'Clear the dialogue window.
LOCATE 22,3
PRINT "Changes made since last save.  Do you want to save?";
GOSUB getyn
IF (answer$="y") OR (answer$="Y") THEN GOSUB savewave

RETURN

'* Begin Subroutine *'

getyn:                       'Get a yes or no reply.
ynloop:
answer$=INKEY$
IF answer$="" THEN ynloop
IF (answer$<>"Y") AND (answer$<>"N") AND (answer$<>"y") AND (answer$<>"n") THEN ynloop
RETURN

SUB box (x1,y1,x2,y2,colr) STATIC        'Draw a box.

'Note that the numbers in the call must be long integers.
'constants must have a ! behind them, as in 511!.

LINE (x1,y1)-(x1,y2),colr
LINE (x1,y1)-(x2,y1),colr
LINE (x2,y1)-(x2,y2),colr
LINE (x2,y2)-(x1,y2),colr

END SUB